Class FileSystemEx
Private fso

' 类初始化
Private Sub Class_Initialize()
	Set fso = CreateObject("Scripting.FileSystemObject")
End Sub

' 类销毁
Private Sub Class_Terminate()
	Set fso = Nothing
End Sub

' ================ 目录操作 ================

' 创建目录
Public Function CreateFolder(path)
	On Error Resume Next
	If Not FolderExists(path) Then
	fso.CreateFolder path
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.CreateFolder", Err.Description
	End If
	End If
	On Error GoTo 0
End Function

' 删除目录
Public Sub DeleteFolder(path, force)
	On Error Resume Next
	If FolderExists(path) Then
	fso.DeleteFolder path, force
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.DeleteFolder", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 目录是否存在
Public Function FolderExists(path)
	FolderExists = fso.FolderExists(path)
End Function

' 获取目录下所有文件
Public Function GetFiles(folderPath)
	Dim folder, file, files()
	ReDim files(-1)

	If FolderExists(folderPath) Then
	Set folder = fso.GetFolder(folderPath)
	For Each file In folder.Files
	ReDim Preserve files(UBound(files) + 1)
	files(UBound(files)) = file.Path
	Next
	End If

	GetFiles = files
End Function

' 获取目录下所有子目录
Public Function GetSubFolders(folderPath)
	Dim folder, subfolder, folders()
	ReDim folders(-1)

	If FolderExists(folderPath) Then
	Set folder = fso.GetFolder(folderPath)
	For Each subfolder In folder.SubFolders
	ReDim Preserve folders(UBound(folders) + 1)
	folders(UBound(folders)) = subfolder.Path
	Next
	End If

	GetSubFolders = folders
End Function

' 复制目录
Public Sub CopyFolder(source, destination, overwrite)
	On Error Resume Next
	If FolderExists(source) Then
	fso.CopyFolder source, destination, overwrite
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.CopyFolder", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 移动目录
Public Sub MoveFolder(source, destination)
	On Error Resume Next
	If FolderExists(source) Then
	fso.MoveFolder source, destination
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.MoveFolder", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 获取目录属性
Public Function GetFolderAttributes(folderPath)
	Dim attr
	If FolderExists(folderPath) Then
	attr = fso.GetFolder(folderPath).Attributes
	GetFolderAttributes = ParseAttributes(attr)
	Else
	GetFolderAttributes = Array()
	End If
End Function

' ================ 文件操作 ================

' 文件是否存在
Public Function FileExists(filePath)
	FileExists = fso.FileExists(filePath)
End Function

' 创建文件
Public Sub CreateFile(filePath)
	On Error Resume Next
	If Not FileExists(filePath) Then
	fso.CreateTextFile(filePath).Close
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.CreateFile", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 删除文件
Public Sub DeleteFile(filePath)
	On Error Resume Next
	If FileExists(filePath) Then
	fso.DeleteFile filePath
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.DeleteFile", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 复制文件
Public Sub CopyFile(source, destination, overwrite)
	On Error Resume Next
	If FileExists(source) Then
	fso.CopyFile source, destination, overwrite
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.CopyFile", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 移动文件
Public Sub MoveFile(source, destination)
	On Error Resume Next
	If FileExists(source) Then
	fso.MoveFile source, destination
	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.MoveFile", Err.Description
	End If
	End If
	On Error GoTo 0
End Sub

' 读取文件内容
Public Function ReadFile(filePath)
	Dim file, content
	On Error Resume Next

	If FileExists(filePath) Then
	Set file = fso.OpenTextFile(filePath, 1) ' 1 = ForReading
	content = file.ReadAll
	file.Close
	ReadFile = content
	Else
	Err.Raise 53, "FileSystem.ReadFile", "文件未找到: " & filePath
	End If

	On Error GoTo 0
End Function

' 写入文件内容
Public Sub WriteFile(filePath, content, overwrite)
	Dim mode
	On Error Resume Next

	If overwrite Then
	mode = 2 ' ForWriting
	Else
	mode = 8 ' ForAppending
	End If

	Set file = fso.OpenTextFile(filePath, mode, True) ' True = 如果不存在则创建
	file.Write content
	file.Close

	If Err.Number <> 0 Then
	Err.Raise Err.Number, "FileSystem.WriteFile", Err.Description
	End If

	On Error GoTo 0
End Sub

' 获取文件大小
Public Function GetFileSize(filePath)
	If FileExists(filePath) Then
	GetFileSize = fso.GetFile(filePath).Size
	Else
	GetFileSize = -1
	End If
End Function

' 获取文件属性
Public Function GetFileAttributes(filePath)
	Dim attr
	If FileExists(filePath) Then
	attr = fso.GetFile(filePath).Attributes
	GetFileAttributes = ParseAttributes(attr)
	Else
	GetFileAttributes = Array()
	End If
End Function

' 获取文件修改时间
Public Function GetFileModifiedTime(filePath)
	If FileExists(filePath) Then
	GetFileModifiedTime = fso.GetFile(filePath).DateLastModified
	Else
	GetFileModifiedTime = Null
	End If
End Function

' ================ 路径操作 ================

' 组合路径
Public Function CombinePath(path1, path2)
	CombinePath = fso.BuildPath(path1, path2)
End Function

' 获取文件名
Public Function GetFileName(filePath)
	GetFileName = fso.GetFileName(filePath)
End Function

' 获取文件扩展名
Public Function GetExtensionName(filePath)
	GetExtensionName = fso.GetExtensionName(filePath)
End Function

' 获取父目录
Public Function GetParentFolder(path)
	GetParentFolder = fso.GetParentFolderName(path)
End Function

' 获取绝对路径
Public Function GetAbsolutePath(path)
	GetAbsolutePath = fso.GetAbsolutePathName(path)
End Function

' ================ 实用方法 ================

' 解析文件属性
Private Function ParseAttributes(attr)
	Dim attrs()
	ReDim attrs(-1)

	If attr And 1 Then ' ReadOnly
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "ReadOnly"
	End If

	If attr And 2 Then ' Hidden
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Hidden"
	End If

	If attr And 4 Then ' System
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "System"
	End If

	If attr And 8 Then ' Volume
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Volume"
	End If

	If attr And 16 Then ' Directory
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Directory"
	End If

	If attr And 32 Then ' Archive
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Archive"
	End If

	If attr And 64 Then ' Alias
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Alias"
	End If

	If attr And 128 Then ' Compressed
	ReDim Preserve attrs(UBound(attrs) + 1)
	attrs(UBound(attrs)) = "Compressed"
	End If

	ParseAttributes = attrs
End Function

' 递归删除目录
Public Sub DeleteFolderRecursive(folderPath)
	If FolderExists(folderPath) Then
	' 先删除所有文件
	Dim files
	files = GetFiles(folderPath)
	For Each file In files
	DeleteFile file
	Next

	' 递归删除子目录
	Dim subFolders
	subFolders = GetSubFolders(folderPath)
	For Each subFolder In subFolders
	DeleteFolderRecursive subFolder
	Next

	' 删除空目录
	DeleteFolder folderPath, False
	End If
End Sub

' 递归复制目录
Public Sub CopyFolderRecursive(source, destination, overwrite)
	If FolderExists(source) Then
	' 创建目标目录
	If Not FolderExists(destination) Then
	CreateFolder destination
	End If

	' 复制所有文件
	Dim files
	files = GetFiles(source)
	For Each file In files
	Dim destFile
	destFile = CombinePath(destination, GetFileName(file))
	CopyFile file, destFile, overwrite
	Next

	' 递归复制子目录
	Dim subFolders
	subFolders = GetSubFolders(source)
	For Each subFolder In subFolders
	Dim folderName, destSubFolder
	folderName = GetFileName(subFolder)
	destSubFolder = CombinePath(destination, folderName)
	CopyFolderRecursive subFolder, destSubFolder, overwrite
	Next
	End If
End Sub

' 查找文件
Public Function FindFiles(folderPath, pattern)
    'On Error Resume Next
    Dim shell, folder, item, foundFiles()
    ReDim foundFiles(-1) ' 初始化为空数组

    ' 检查文件夹是否存在
    If FolderExists(folderPath) Then
        Set shell = CreateObject("Shell.Application")
        Set folder = shell.NameSpace(folderPath)
        
        If Not folder Is Nothing Then
            For Each item In folder.Items
                If item.IsFolder = False Then
					Dim regex
					Set regex = New RegExp
					regex.Pattern = pattern '".*\.log$" ' 模式含义：任意字符开头，以 .log 结尾
					regex.IgnoreCase = True    ' 忽略大小写	
                    If regex.Test(item.Name) Then
						
                        ReDim Preserve foundFiles(UBound(foundFiles) + 1)
                        foundFiles(UBound(foundFiles)) = item.Path
                    End If
					Set regex = nothing
                End If
            Next
        End If
    End If
    
    FindFiles = foundFiles
End Function

End Class